home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 98 / Skunkware 98.iso / src / interp / tclStruct1.2.tar.gz / tclStruct1.2.tar / tclStruct1.2 / stInternal.h < prev    next >
C/C++ Source or Header  |  1995-10-17  |  8KB  |  200 lines
  1. /*
  2.  *    tclStruct package
  3.  *  Support 'C' structures in Tcl
  4.  *
  5.  *  Written by Matthew Costello
  6.  *  (c) 1995 AT&T Global Information Solutions, Dayton Ohio USA
  7.  *
  8.  *  See the file "license.terms" for information on usage and
  9.  *  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  10.  *
  11.  *  The inspiration for this came from Laurent Demailly's tclbin package.
  12.  *  I hadn't realized how much variable traces could be perverted :-)
  13.  *
  14.  */
  15.  
  16.  
  17. #ifdef lint
  18. # define STRUCT_SCCSID(sccsid)
  19. #else
  20. # define STRUCT_SCCSID(sccsid)    static char struct_sourceID[] = sccsid ;
  21. static char struct_inthdrID[] = "@(#)tclStruct:stInternal.h    1.3    95/09/12";
  22. #endif
  23.  
  24. #ifdef STDC_HEADERS
  25. #include <stdlib.h>
  26. #endif
  27. #ifdef HAVE_UNISTD_H
  28. #include <unistd.h>
  29. #endif
  30. #include <limits.h>
  31. #include <float.h>
  32. #include <stdio.h>
  33. #include <string.h>
  34. #include <ctype.h>
  35. #include "tcl.h"
  36. #include <malloc.h>
  37. #include "tclStruct.h"
  38.  
  39. /*
  40.  *  The tclStruct package supports the type definition of complex 'C'
  41.  *  data structures and the creation/referencing them through Tcl
  42.  *  associative arrays.
  43.  */
  44.  
  45.  
  46. /*  Internal information needed/used by this package.  This information
  47.  *  is per-interpreter, so it is stored as the ClientData associated
  48.  *  with the tclStruct Tcl commands.
  49.  */
  50. typedef struct {
  51.     Tcl_HashTable    si_typeHash;    /* Hash table for defined types */
  52.  
  53.     /* Statistics */
  54.     int        si_cmdCount;    /* number of commands executed */
  55.     int        si_rdCount;    /* number of read accesses */
  56.     int        si_wrCount;    /* number of write accesses */
  57.     int        si_nNewTypes;    /* number of created types */
  58.     int        si_nExTypes;    /* number of destroyed types */
  59. } Struct_PkgInfo_t;
  60. #define Struct_PkgInfo(cdata,elem)    (((Struct_PkgInfo_t *)cdata)->elem)
  61. #define Struct_TypeHash(cdata)    (&((Struct_PkgInfo_t *)cdata)->si_typeHash)
  62.  
  63.  
  64. /* ****************************************************************** */
  65. #ifdef DEBUG
  66. /*  When DEBUG is defined, enable the display of debugging messages.
  67.  */
  68. extern    int            struct_debug;
  69. #define DBG_NONE        0
  70. #define DBG_REFCOUNT        000001
  71. #define DBG_NEWTYPE        000002
  72. #define DBG_PARSETYPE        000004
  73. #define DBG_PARSEELEMENT    000010
  74. #define DBG_LOOKUP        000020
  75. #define DBG_NEWOBJECT        000040
  76. #define DBG_GETOBJECT        000100
  77. #define DBG_FLOAT        000200
  78. #define DBG_INT            000400
  79. #define DBG_UNSET        001000
  80. #define DBG_COMMAND        002000
  81. #define DBG_CHAR        004000
  82. #define DBG_ARRAY        010000
  83. #define DBG_VARLEN        020000
  84. #define DBG_IO            040000
  85.  
  86. EXTERN void Struct_PrintCommand _ANSI_ARGS_((int,char **));
  87. EXTERN CONST char *Struct_TypeName _ANSI_ARGS_((Struct_TypeDef *));
  88. EXTERN CONST char *Struct_ObjectName _ANSI_ARGS_((Struct_Object *, int));
  89. #endif    /*DEBUG*/
  90.  
  91. #ifdef DEBUG
  92. /*VARARGS*/
  93. EXTERN void panic _ANSI_ARGS_((char *fmt,...));    /* Internal to Tcl7.5 */
  94. #ifdef STRUCT_MAGIC
  95. # define Struct_CheckType(typeptr,where) \
  96.     if (typeptr == NULL) \
  97.         panic("NULL type in Struct_%s", where); \
  98.     else if (typeptr->magic != STRUCT_MAGIC_TYPE) \
  99.         panic("Corruption of type structure %p in Struct_%s", \
  100.             (void *)typeptr, where ); \
  101.     else if (typeptr->refcount <= 0) \
  102.         panic("Negative refcount of type %s in Struct_%s", \
  103.             Struct_TypeName(typeptr), where )
  104. # define Struct_CheckObject(objectptr,where) \
  105.     if (objectptr == NULL) \
  106.         panic("NULL object in Struct_%s", where); \
  107.     else if (objectptr->magic != STRUCT_MAGIC_OBJECT) \
  108.         panic("Corruption of object structure %p in Struct_%s", \
  109.             (void *)objectptr, where ); \
  110.     Struct_CheckType(objectptr->type,where)
  111. #else    /*STRUCT_MAGIC*/
  112. # define Struct_CheckType(typeptr,where) \
  113.     if (typeptr == NULL) \
  114.         panic("NULL type in Struct_%s", where); \
  115.     else if (typeptr->refcount <= 0) \
  116.         panic("Negative refcount of type %s in Struct_%s", \
  117.             Struct_TypeName(typeptr), where )
  118. # define Struct_CheckObject(objectptr,where) \
  119.     if (objectptr == NULL) \
  120.         panic("NULL object in Struct_%s", where); \
  121.     Struct_CheckType(objectptr->type,where)
  122. #endif    /*!STRUCT_MAGIC*/
  123. #else    /*DEBUG*/
  124. # define Struct_CheckType(typeptr,where)
  125. # define Struct_CheckObject(objectptr,where)
  126. #endif    /*DEBUG*/
  127.  
  128. /* ****************************************************************** */
  129.  
  130. /*
  131.  *  These macros provide very low-level access to the Struct_Object
  132.  *  associated with a tclStruct associative array.  These macros
  133.  *  should only be used to check that an object does, or does not,
  134.  *  exist.
  135.  */
  136. #define STRUCT_GETOBJECT(interp,name) (Tcl_VarTraceInfo(interp,name,0,Struct_MainTraceProc,(ClientData)NULL))
  137. #define STRUCT_GETOBJECT2(interp,name1,name2) (Tcl_VarTraceInfo2(interp,name1,name2,0,Struct_MainTraceProc,(ClientData)NULL))
  138.  
  139. /* ****************************************************************** */
  140.  
  141. /*
  142.  *  Internal 'C' interfaces using within the tclStruct package:
  143.  */
  144.  
  145. EXTERN CONST char *Struct_AccessElement _ANSI_ARGS_((Tcl_Interp *,Struct_Object *,char*));
  146. EXTERN CONST char *Struct_GenerateName _ANSI_ARGS_((const char *));
  147. EXTERN Struct_Object *Struct_NewObject _ANSI_ARGS_((Struct_TypeDef *,void *,int));
  148. EXTERN Struct_TypeDef * Struct_CloneType _ANSI_ARGS_((ClientData, Tcl_Interp *, const char *, Struct_TypeDef *));
  149. EXTERN Struct_TypeDef * Struct_DefArray _ANSI_ARGS_((ClientData, Tcl_Interp *, Struct_TypeDef *, int));
  150. EXTERN Struct_TypeDef * Struct_InstantiateType _ANSI_ARGS_((ClientData, Tcl_Interp *, const char *, Struct_TypeDef *, int));
  151. EXTERN Struct_TypeDef * Struct_LookupType _ANSI_ARGS_((ClientData, Tcl_Interp *,const char *typename));
  152. EXTERN Struct_TypeDef * Struct_NewType _ANSI_ARGS_((ClientData, Tcl_Interp *, const char *, int, int, Tcl_VarTraceProc *));
  153. EXTERN Struct_TypeDef * Struct_ParseDefOptions _ANSI_ARGS_((ClientData, Tcl_Interp *, Struct_TypeDef *, Struct_StructElem *, int, char **));
  154. EXTERN int Struct_CopyCmd _ANSI_ARGS_((ClientData, Tcl_Interp *,int , char **));
  155. EXTERN int Struct_DebugInfo _ANSI_ARGS_((ClientData,Tcl_Interp *,int,char **));
  156. EXTERN int Struct_DefType _ANSI_ARGS_((ClientData, Tcl_Interp *, CONST char *,char *));
  157. EXTERN int Struct_GetObject _ANSI_ARGS_((Tcl_Interp *,const char*,Struct_Object *));
  158. EXTERN int Struct_GetObjectAndCheck _ANSI_ARGS_((Tcl_Interp *,const char*,const char *,Struct_Object *));
  159. EXTERN int Struct_InfoCmd _ANSI_ARGS_((ClientData, Tcl_Interp *,int , char **));
  160. EXTERN int Struct_NewCmd _ANSI_ARGS_((ClientData, Tcl_Interp *,int , char **));
  161. EXTERN int Struct_ReadCmd _ANSI_ARGS_((ClientData, Tcl_Interp *,int , char **));
  162. EXTERN int Struct_RegisterBuiltInType _ANSI_ARGS_((ClientData, Tcl_Interp *, const char *, int, int, Tcl_VarTraceProc *));
  163. EXTERN int Struct_RegisterType _ANSI_ARGS_((ClientData, Tcl_Interp *, const char *, Struct_TypeDef *));
  164. EXTERN int Struct_TypeDefCmd _ANSI_ARGS_((ClientData, Tcl_Interp *,int , char **));
  165. EXTERN int Struct_UnTypeDefCmd _ANSI_ARGS_((ClientData, Tcl_Interp *,int , char **));
  166. EXTERN int Struct_WriteCmd _ANSI_ARGS_((ClientData, Tcl_Interp *,int , char **));
  167. EXTERN void Struct_AttachType _ANSI_ARGS_((Struct_TypeDef *));
  168. EXTERN void Struct_DeleteObject _ANSI_ARGS_((Struct_Object *));
  169. EXTERN void Struct_ReleaseType _ANSI_ARGS_((Struct_TypeDef *));
  170. EXTERN int Struct_GetBinaryInt _ANSI_ARGS_((void *, int, int));
  171. EXTERN void Struct_PutBinaryInt _ANSI_ARGS_((int, void *, int, int));
  172.  
  173.  
  174. /*
  175.  *  Each structure instance is a tcl array,
  176.  *  with an attached memory buffer holding the contents
  177.  *  of the structure, as well as a pointer to the definition
  178.  *  of the structure.  References to the structure are caught
  179.  *  by our trace proc to do any R/W conversion and access the
  180.  *  'real' structure in the memory buffer.
  181.  */
  182. EXTERN Tcl_VarTraceProc    Struct_MainTraceProc;
  183.  
  184. /*
  185.  *  The Tcl trace procedures for our built-in types.  These
  186.  *  routines are only called by Struct_MainTraceProc, which
  187.  *  passes the Struct_Ojbect as ClientData.
  188.  */
  189. EXTERN Tcl_VarTraceProc    Struct_TraceChar;
  190. EXTERN Tcl_VarTraceProc    Struct_TraceInt;
  191. EXTERN Tcl_VarTraceProc    Struct_TraceDouble;
  192. EXTERN Tcl_VarTraceProc    Struct_TraceHex;
  193. EXTERN Tcl_VarTraceProc    Struct_TraceFloat;
  194. EXTERN Tcl_VarTraceProc    Struct_TracePtr;
  195. EXTERN Tcl_VarTraceProc    Struct_TraceAddr;
  196. EXTERN Tcl_VarTraceProc    Struct_TraceString;
  197. EXTERN Tcl_VarTraceProc    Struct_TraceStruct;
  198. EXTERN Tcl_VarTraceProc    Struct_TraceArray;
  199.  
  200.